home *** CD-ROM | disk | FTP | other *** search
VERSION 2.00 Begin Form GenForm BackColor = &H00C0C0C0& Caption = "Form Wizard - Generate Form" ClientHeight = 2610 ClientLeft = 2085 ClientTop = 1380 ClientWidth = 7365 ControlBox = 0 'False Height = 3015 HelpContextID = 32 Icon = GENFORM.FRX:0000 Left = 2025 LinkTopic = "Form3" MaxButton = 0 'False ScaleHeight = 2610 ScaleWidth = 7365 Top = 1035 Width = 7485 Begin SSCommand BtnHelp Caption = "&Help" Font3D = 2 'Raised w/heavy shading Height = 615 Left = 5160 Picture = GENFORM.FRX:0302 TabIndex = 11 Top = 1500 Width = 915 End Begin TextBox TxtTmpltName BackColor = &H00C0C0C0& Height = 375 Left = 1560 TabIndex = 0 Tag = "Name of the form template" Top = 360 Width = 4995 End Begin SSCommand BtnFindTmplt AutoSize = 2 'Adjust Button Size To Picture Font3D = 2 'Raised w/heavy shading Height = 600 Left = 6660 Picture = GENFORM.FRX:0604 TabIndex = 1 Tag = "Press to find the database" Top = 120 Width = 600 End Begin SSPanel cMsg Align = 2 'Align Bottom Alignment = 1 'Left Justify - MIDDLE BevelInner = 1 'Inset BorderWidth = 2 Height = 375 Left = 0 TabIndex = 8 Top = 2235 Width = 7365 End Begin SSCommand BtnFinish AutoSize = 2 'Adjust Button Size To Picture Caption = "&Finish" Font3D = 2 'Raised w/heavy shading Height = 615 Left = 4260 Picture = GENFORM.FRX:0906 TabIndex = 7 Tag = "Generate the form code" Top = 1500 Width = 915 End Begin SSCommand BtnCancel AutoSize = 2 'Adjust Button Size To Picture Caption = "&Cancel" Font3D = 2 'Raised w/heavy shading Height = 615 Left = 3360 Picture = GENFORM.FRX:0C08 TabIndex = 6 Tag = "Cancel building the form" Top = 1500 Width = 915 End Begin SSCommand BtnNext AutoSize = 2 'Adjust Button Size To Picture Caption = "&Next" Enabled = 0 'False Font3D = 2 'Raised w/heavy shading Height = 615 Left = 2460 Picture = GENFORM.FRX:0F0A TabIndex = 5 Top = 1500 Width = 915 End Begin SSCommand BtnPrev AutoSize = 2 'Adjust Button Size To Picture Caption = "&Previous" Font3D = 2 'Raised w/heavy shading Height = 615 Left = 1560 Picture = GENFORM.FRX:120C TabIndex = 4 Tag = "Return to previous step" Top = 1500 Width = 915 End Begin TextBox TxtFrmName BackColor = &H00C0C0C0& Height = 375 Left = 1560 TabIndex = 2 Tag = "Name to save the form as" Top = 1020 Width = 4995 End Begin SSCommand BtnFindForm AutoSize = 2 'Adjust Button Size To Picture Font3D = 2 'Raised w/heavy shading Height = 600 Left = 6660 Picture = GENFORM.FRX:150E TabIndex = 3 Tag = "Press to find the database" Top = 780 Width = 600 End Begin CommonDialog CMDialog1 DefaultExt = "frm" DialogTitle = "Save Form As" Filter = "VB Forms|*.frm" Left = 300 Top = 1380 End Begin Label Label1 Alignment = 1 'Right Justify AutoSize = -1 'True BackColor = &H00C0C0C0& Caption = "Form Name" ForeColor = &H00FF0000& Height = 195 Index = 2 Left = 525 TabIndex = 10 Top = 1080 Width = 960 End Begin Label Label1 Alignment = 1 'Right Justify AutoSize = -1 'True BackColor = &H00C0C0C0& Caption = "Form Template" ForeColor = &H00FF0000& Height = 195 Index = 3 Left = 225 TabIndex = 9 Top = 420 Width = 1260 End Option Explicit Dim stemplate As String, sForm As String ' names for template and form files Dim sFormLine As String, msg As String Dim indent As Integer ' number spaces to indent line Dim iNumLabelLines As Integer ' number of lines in label control definition Dim sLabelLines() As String ' lines in label definition Dim iNumTextLines As Integer ' number of lines in Text control definition Dim sTextLines() As String ' lines in textbox definition Dim dSvLabel1Top As Double ' save area for label1 top Dim dSvLabel1Left As Double ' save area for label1 left Dim dSvLabel2Top As Double ' save area for label2 top Dim dLabelInc As Double ' amount to increment each label top by Dim dSvText1Top As Double ' save area for textbox1 top Dim dSvText1Left As Double ' save area for textbox1 left Dim dSvText2Top As Double ' save area for textbox2 top Dim dTextInc As Double ' amount to increment each textbox top by Sub BtnCancel_Click () EndItNow End Sub Sub BtnCancel_GotFocus () cMsg.Caption = BtnCancel.Tag End Sub Sub BtnCancel_LostFocus () cMsg.Caption = "" End Sub Sub BtnFindForm_Click () CMDialog1.DialogTitle = "Save Form As" CMDialog1.Filename = CaptnFrm.TxtName & ".Frm" CMDialog1.Flags = OFN_OVERWRITEPROMPT + OFN_PATHMUSTEXIST CMDialog1.Action = 2 If CMDialog1.Filename <> "" Then TxtFrmName.Text = CMDialog1.Filename End If End Sub Sub BtnFindForm_GotFocus () cMsg.Caption = BtnFindForm.Caption End Sub Sub BtnFindTmplt_Click () CMDialog1.DialogTitle = "Select Form Template" CMDialog1.Filename = "" CMDialog1.Flags = OFN_FILEMUSTEXIST CMDialog1.Action = 1 If CMDialog1.Filename <> "" Then TxtTmpltName = CMDialog1.Filename End If End Sub Sub BtnFindTmplt_GotFocus () cMsg.Caption = BtnFindTmplt.Caption End Sub Sub BtnFinish_Click () Dim msg As String On Error GoTo GenerateErr mousepointer = HOURGLASS ' Verify that file names are correct stemplate = TxtTmpltName.Text If Right$(UCase$(TxtFrmName.Text), 4) <> ".FRM" Then TxtFrmName.Text = TxtFrmName.Text & ".FRM" End If sForm = TxtFrmName.Text If stemplate = "" Then Beep mousepointer = DEFAULT MsgBox "You must specify a form template or use the file drawer button to locate a form template.", 0 + 48 + 0 + 0, "Form Template Error" TxtTmpltName.SetFocus Exit Sub End If If Dir$(stemplate) = "" Then Beep mousepointer = DEFAULT MsgBox "The form template you have specified does not exist! Use the file drawer button to locate a form template.", 0 + 48 + 0 + 0, "Form Template Error" TxtTmpltName.SetFocus Exit Sub End If If sForm = "" Then Beep mousepointer = DEFAULT MsgBox "You must specify a form name or use the file drawer button to locate a form.", 0 + 48 + 0 + 0, "Form Save Error" TxtFrmName.SetFocus Exit Sub End If If sForm = stemplate Then Beep mousepointer = DEFAULT MsgBox "You cannot use the template as the output form.", 0 + 48 + 0 + 0, "Form Save Error" TxtFrmName.SetFocus Exit Sub End If On Error GoTo erropeningtemplate Open stemplate For Input Access Read Lock Write As #1 On Error GoTo erropeningform Open sForm For Output Access Write Lock Read Write As #2 On Error GoTo GenerateErr indent = 0 Do While Not EOF(1) Input #1, sFormLine Select Case True Case InStr(1, sFormLine, "Begin Form", 1) <> 0 ' Beginning of form Print #2, "Begin Form " & CaptnFrm.TxtName.Text indent = 3 Case InStr(1, sFormLine, "Caption", 1) <> 0 ' Form Caption line Print #2, Spc(indent); "Caption = " & Chr$(34) & CaptnFrm.TxtCaption.Text & Chr$(34) Case InStr(1, sFormLine, "Begin ", 1) <> 0 ' Beginning of control Select Case True Case InStr(1, sFormLine, " Lbl1", 1) <> 0 ' Beginning of label 1 SaveLabel1 Case InStr(1, sFormLine, " Lbl2", 1) <> 0 ' Beginning of label 2 SaveLabel2 Case InStr(1, sFormLine, " Fld1", 1) <> 0 ' Beginning of field 1 SaveField1 Case InStr(1, sFormLine, " Fld2", 1) <> 0 ' Beginning of field 2 SaveField2 Case InStr(1, sFormLine, " Data", 1) <> 0 ' Beginning of data control SaveDataCtrl Case Else ' Beginning of other control SaveControl End Select Case InStr(1, sFormLine, "End", 1) <> 0 ' End of form If Len(sFormLine) < InStr(1, sFormLine, "End", 1) + 4 Then GotEndOfForm Else Print #2, Spc(indent); sFormLine ' Output any unrecognized lines as is End If Case Else Print #2, Spc(indent); sFormLine ' Output any unrecognized lines as is End Select Loop Close #1 Close #2 msg = "Form " & sForm & " generated." Beep mousepointer = DEFAULT MsgBox msg, MB_ICONINFORMATION, "Form Wizard Generation" db.Close ' Close the database Unload CaptnFrm ' Unload all forms Unload DataSpec Unload FieldFrm MainForm.Show MODELESS Unload GenForm Exit Sub GenerateErr: erraction = RB_ErrorHandler("GenForm", "BtnFinish_Click") Select Case erraction Case 1 Resume 0 ' Retry option selected Case 2 Resume Next ' Ignore option selected End Select On Error Resume Next Close #1, #2 On Error GoTo GenerateErr Exit Sub erropeningtemplate: Beep mousepointer = DEFAULT msg = "A " & Error & " error has occurred opening the template file! Please correct and retry the function" MsgBox msg, 0 + 48 + 0 + 0, "Form Template Error" TxtTmpltName.SetFocus Close #1, #2 On Error GoTo GenerateErr Exit Sub erropeningform: Beep mousepointer = DEFAULT msg = "A " & Error & " error has occurred opening the output form file! Please correct and retry the function" MsgBox msg, 0 + 48 + 0 + 0, "Form Output Error" TxtTmpltName.SetFocus Exit Sub End Sub Sub BtnFinish_GotFocus () cMsg.Caption = BtnFinish.Tag End Sub Sub BtnFinish_LostFocus () cMsg.Caption = "" End Sub Sub BtnHelp_Click () SendKeys "{F1}" End Sub Sub BtnPrev_Click () FieldFrm.Show MODELESS GenForm.Hide End Sub Sub BtnPrev_GotFocus () cMsg.Caption = BtnPrev.Tag End Sub Sub BtnPrev_LostFocus () cMsg.Caption = "" End Sub Sub FldGotFocus (PControl As Control) PControl.BackColor = BLUE PControl.ForeColor = WHITE PControl.SelStart = 0 PControl.SelLength = 1000 cMsg.Caption = PControl.Tag End Sub Sub FldLostFocus (PControl As Control) PControl.BackColor = RB_GRAY PControl.ForeColor = BLACK cMsg.Caption = "" End Sub Sub Form_Paint () Form3d Me End Sub Sub TxtFrmName_GotFocus () FldGotFocus TxtFrmName End Sub Sub TxtFrmName_LostFocus () FldLostFocus TxtFrmName End Sub Sub TxtTmpltName_GotFocus () FldGotFocus TxtTmpltName End Sub Sub TxtTmpltName_LostFocus () FldLostFocus TxtTmpltName End Sub 
(.txt)